Geo-Visualisierung

Aufgabenstellung:

Die Aufgabe besteht in der Darstellung von Daten im Kontext geographischer Karten, z.B. Wahlkreise und der Anteil von Stimmen für bestimmte Parteien und die Arbeitslosenquote in diesen Bezirken.

Einführung

Im Folgenden wird in die geographische Visualisierung mit R eingeführt. Es werden die Grundlagen zum Darstellen von Daten in geographischem Kontext behandelt sowie an zwei konkreten Beispielen vorgestellt. todo mehr

Zeichnen von geographischen Karten

Die Grundlage zum Zeichnen von geographischen Grenzen bilden die sogenannten Shape-Files. In diesem Format lassen sich Geometriedaten leicht darstellen. In diesem Projekt wird ein Shape-File zur Darstellung der Grenzen der deutschen Bundesländer verwendet. Ein Shape-File ist Dateiformat welches geographische Vektordaten enthält. Es eignet sich unteranderem zum Zeichnen von Grenzen. Dieses Shape-File wird von dem Bundesamt für Kartographie und Geodäsie bereitgestellt. Im Folgenden Code-Ausschnitt wird das Shape-File eingelesen und beispielhaft die darin enthaltenen Daten ausgegeben.

map <- st_read("data/2500_NUTS1.shp", stringsAsFactors=FALSE)

## Reading layer `2500_NUTS1' from data source `/Users/nahkusaidy/Documents/Repositories/GeoVisualisation/data/2500_NUTS1.shp' using driver `ESRI Shapefile'
## Simple feature collection with 16 features and 3 fields
## geometry type:  MULTIPOLYGON
## dimension:      XY
## bbox:           xmin: 3280341 ymin: 5237533 xmax: 3921264 ymax: 6103334
## epsg (SRID):    31467
## proj4string:    +proj=tmerc +lat_0=0 +lon_0=9 +k=1 +x_0=3500000 +y_0=0 +ellps=bessel +towgs84=598.1,73.7,418.2,0.202,0.045,-2.455,6.7 +units=m +no_defs

map = st_transform(map,3857)
ggplot(map) + geom_sf()

Neben reinen Shape-Files gibt es in R die Möglichkeit auch todo “realistischere” Karten zu zeichnen. Hier wird beispielhaft eine Karte von Deutschland von OpenStreetMap gezeichnet.

germany_map <- get_map(getbb("Deutschland", base_url = "https://nominatim.openstreetmap.org", featuretype = "country"),maptype = "toner-background")
ggmap(germany_map)

Binnenwanderung

Um die Möglichkeiten der Darstellung von Daten in geographischem Kontext zu demonstrieren werden nun Daten aus einem Datensatz zur Binnenwanderung in Deutschland analysiert und dargestellt. Dieser wird zuerst importiert und die zu visualisierenden Daten in Data Frames verpackt. Die Daten enthalten das Saldo der Binnenwanderung für jedes Bundesland von Deutschen und Ausländern.

binnenwanderung_data <- read_excel("binnenwanderung.xlsx")

## New names:
## * `` -> ...2

states <- map$NUTS_NAME
movement_per_state <- data.frame(matrix(ncol = 16, nrow = 16))
x <- c("NUTS_NAME",sprintf("%s",2003:2017))
colnames(movement_per_state) <- x

movement_per_state_mean <- data.frame(NUTS_NAME = c(1:16), Mean_Migration = c(1:16))
movement_per_state_sum <- data.frame(NUTS_NAME = c(1:16), Sum_Migration = c(1:16))

for(i in 1:length(states)){
  index <- which(binnenwanderung_data == states[i], arr.ind = TRUE)[1]+2
  row_data = binnenwanderung_data[index,-1:-3]
  data_frame_row = c(c(states[i]), row_data)
  names(data_frame_row) <- x
  movement_per_state[i,] = data_frame_row
  movement_per_state_mean$NUTS_NAME[i] = states[i]
  movement_per_state_mean$Mean_Migration[i] = mean(as.numeric(as.character(row_data)))
  movement_per_state_sum$NUTS_NAME[i] = states[i]
  movement_per_state_sum$Sum_Migration[i] = sum(as.numeric(as.character(row_data)))
}
str(movement_per_state)

## 'data.frame':    16 obs. of  16 variables:
##  $ NUTS_NAME: chr  "Baden-Württemberg" "Bayern" "Berlin" "Brandenburg" ...
##  $ 2003     : num  26926 34212 -7043 -498 673 ...
##  $ 2004     : num  22055 25695 -9133 742 1131 ...
##  $ 2005     : num  15394 29432 -4328 -522 810 ...
##  $ 2006     : num  5673 34153 1955 -3045 1371 ...
##  $ 2007     : num  10039 31477 7377 -4021 -292 ...
##  $ 2008     : num  12840 26151 12958 -4102 222 ...
##  $ 2009     : num  1070 15632 18353 -2173 1590 ...
##  $ 2010     : num  -1604 10746 17990 -1518 852 ...
##  $ 2011     : num  1054 15363 15341 -1596 -564 ...
##  $ 2012     : num  1880 15486 12134 1252 -378 ...
##  $ 2013     : num  -1315 14085 8068 4275 -635 ...
##  $ 2014     : num  -398 6677 2672 8921 -1910 ...
##  $ 2015     : num  1273 4011 -4628 12315 -3182 ...
##  $ 2016     : num  -4388 -1741 7891 9873 920 ...
##  $ 2017     : num  -5107 6593 -3013 14458 -2916 ...

str(movement_per_state_mean)

## 'data.frame':    16 obs. of  2 variables:
##  $ NUTS_NAME     : chr  "Baden-Württemberg" "Bayern" "Berlin" "Brandenburg" ...
##  $ Mean_Migration: num  5693 17865 5106 2291 -154 ...

Diese Daten werden aufgesplittet in neue und alte Bundesländer, wobei Berlin als altes Bundesland gezählt wird, da im Datensatz nicht zwischen West- und Ostberlin unterschieden wird.

new_states = c("Brandenburg","Mecklenburg-Vorpommern","Sachsen","Sachsen-Anhalt","Thüringen")
new_states_movement = movement_per_state[movement_per_state$NUTS_NAME %in% new_states,]
new_states_movement = new_states_movement[1:5,]
data_of_new_states = colSums(new_states_movement[,-1])

`%notin%` <- Negate(`%in%`)

old_states_movement = movement_per_state[movement_per_state$NUTS_NAME %notin% new_states,]
old_states_movement = old_states_movement[1:11,]
data_of_old_states = colSums(old_states_movement[,-1])

Im Folgenden wird der Vergleich des Saldos der Binnenwanderung zwischen den neuen und alten Bundesländern zwischen 2003 und 2017 in einem Plot dargestellt.

Es ist zu erkennen, dass die Abwanderung von Einwohnern von Ost- nach Westdeutschland bis 2013 immer weiter abgenommen hat. Danach kam es 2014 erstmals zu einer Abwanderung von Einwohnern von West- nach Ostdeutschland.
Eine geographische Darstellung des Durchschnitts des Saldos der Binnenwanderung je Bundesland lässt sich mit folgendem Code realisieren.

ggmap_bbox <- function(map) {
  # Extract the bounding box (in lat/lon) from the ggmap to a numeric vector, 
  # and set the names to what sf::st_bbox expects:
  map_bbox <- setNames(unlist(attr(map, "bb")), 
                       c("ymin", "xmin", "ymax", "xmax"))
  
  # Coonvert the bbox to an sf polygon, transform it to 3857, 
  # and convert back to a bbox (convoluted, but it works)
  bbox_3857 <- st_bbox(st_transform(st_as_sfc(st_bbox(map_bbox, crs = 4326)), 3857))
  
  # Overwrite the bbox of the ggmap object with the transformed coordinates 
  attr(map, "bb")$ll.lat <- bbox_3857["ymin"]
  attr(map, "bb")$ll.lon <- bbox_3857["xmin"]
  attr(map, "bb")$ur.lat <- bbox_3857["ymax"]
  attr(map, "bb")$ur.lon <- bbox_3857["xmax"]
  map
}

germany_map <- ggmap_bbox(germany_map)
merged_movement_mean <- left_join(map,movement_per_state_mean,by="NUTS_NAME")
ggmap(germany_map) + coord_sf(crs=st_crs(3857)) + geom_sf(data=merged_movement_mean, aes(fill= Mean_Migration), inherit.aes = FALSE,alpha=0.5)+
  scale_fill_gradient2(low= "#CC0033", mid="white",high = "#006633")

Das gesamte Saldo ist im nächsten Plot dargestellt. Hier fehlt noch plot von kumuliert auf 5 jahre oder so.

merged_movement_sum<- left_join(map,movement_per_state_sum,by="NUTS_NAME")
ggmap(germany_map) + coord_sf(crs=st_crs(3857)) + geom_sf(data=merged_movement_sum, aes(fill= Sum_Migration), inherit.aes = FALSE,alpha=0.7)+
  scale_fill_gradient2(low= "#CC0033", mid="white",high = "#006633")

votes <- read.csv(file="btw17_kerg.csv", sep=";")
extracted_votes <- data.frame(Votes = votes$X.16, VotesAfD = votes$X.44)
extracted_votes$Votes <- as.numeric(as.character(extracted_votes$Votes))

## Warning: NAs durch Umwandlung erzeugt

extracted_votes$VotesAfD <- as.numeric(as.character(extracted_votes$VotesAfD))

## Warning: NAs durch Umwandlung erzeugt

extracted_votes$PercentageAfD <- (extracted_votes$VotesAfD/extracted_votes$Votes)*100

votes_per_state <- data.frame(NUTS_NAME = c(1:16), Votes_AfD = c(1:16))
for(i in 1:length(states)){
  votes_per_state$NUTS_NAME[i] = states[i]
  votes_per_state$Votes_AfD[i] <- extracted_votes$PercentageAfD[which(votes == states[i], arr.ind = TRUE)]
}

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

## Warning in votes_per_state$Votes_AfD[i] <-
## extracted_votes$PercentageAfD[which(votes == : Anzahl der zu ersetzenden
## Elemente ist kein Vielfaches der Ersetzungslänge

income <- read.csv(file="Stimmenanzahl2.csv", sep=";", colClasses=c("NULL", "NULL", "NULL", NA))
income <- data.frame(NUTS_NAME = map$NUTS_NAME, NETTOEINKOMMEN = income)

merged_stimmen <- left_join(map,votes_per_state,by="NUTS_NAME")
plot_stimmen <- ggplot(merged_stimmen) + geom_sf(aes(fill= Votes_AfD))+
 scale_fill_gradient(low= "#E0E0E0",high = "#FF3300")

merged_einkommen <- left_join(map,income,by="NUTS_NAME")

## Warning: Column `NUTS_NAME` joining character vector and factor, coercing into
## character vector

plot_einkommen <- ggplot(merged_einkommen) + geom_sf(aes(fill= Nettoeinkommen))+
  scale_fill_gradient(low= "#E0E0E0", high = "#FF3300")

grid.arrange(plot_stimmen, plot_einkommen, ncol=2)

x <- votes_per_state[,2]
y <- income[,2]
cor.test(x,y,method="pearson")

## 
##  Pearson's product-moment correlation
## 
## data:  x and y
## t = -3.5337, df = 14, p-value = 0.003306
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.8820924 -0.2894141
## sample estimates:
##        cor 
## -0.6866149

Geo_Visualisation

Nahku Saidy

1/19/2020

Geo-Visualisierung

Aufgabenstellung:

Einführung

Zeichnen von geographischen Karten

Binnenwanderung